home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / win / vb / gmpvb2.exe / WINWORD.BAS < prev    next >
Encoding:
BASIC Source File  |  1991-12-07  |  7.5 KB  |  196 lines
  1. 'Include the following if not declared in the global module
  2. 'Declare Function IsAppLoaded Lib "kernel" Alias "GetModuleHandle" (ByVal N As String) As Integer
  3. 'Const TRUE = -1
  4. 'Const FALSE = 0
  5. 'Const NONE = 0
  6. 'Const HOT = 1
  7. 'Const COLD = 2
  8.  
  9. 'Constants for Window_State function
  10. ' WindowState (form)
  11. 'Const NORMAL = 0                ' 0 - Normal
  12. 'Const MINIMIZED = 1             ' 1 - Minimized
  13. 'Const MAXIMIZED = 2             ' 2 - Maximized
  14.  
  15. 'Variables can be declared in global module and initialized in start up procedure
  16. 'Dim nl As String   'nl = chr$(10) + chr$(13) 'new line
  17. 'Dim q As String    'q = chr$(34)             'quotation marks
  18. 'Dim ProgName As String  'winword filename
  19. 'Dim DirName As String   'directory where winword is located
  20.  
  21. Dim chan1 As String   'Stores channel number of winword DDE link
  22.  
  23. Sub Open_Winword_Document (Document As String)
  24. 'Opens document, if necessary, and makes it current winword document
  25.  If IsAppLoaded("MSWord") = FALSE Then
  26.     xxzz = Shell(ProgName + " " + Document, 3)
  27.  Else
  28.     WordMessage$ = "[FileOpen " + q + Document + q + "]"
  29.     WordMessage$ = WordMessage$ + "[If Not AppMaximize() Then AppMaximize]"
  30.  End If
  31.  Execute WordMessage$
  32. End Sub
  33.  
  34. Function Get_Open_Docs (LBox As Control)
  35. 'This procedure puts a list of open winword documents
  36. 'in the listbox passed as a parameter
  37. 'It does not include macros or duplicate windows
  38.  
  39.   If IsAppLoaded("MSWord") = FALSE Then Exit Function
  40.   If TypeOf LBox Is listbox Then
  41.     If chan1 = "" Then chan1 = Open_Link()
  42.     NumWins = Val(Get_Info("Str$(CountWindows())"))     'Get number of items on winword window list
  43.     If NumWins = 0 Then Exit Function'No open windows
  44.     Get_Open_Docs = NumWins 'Function returns number of open windows
  45.     For idx = 1 To NumWins
  46.       temp$ = Get_Info("WindowName$(" + LTrim$(Str$(idx)) + ")")
  47.       'ColonPos = InStr(temp$, ":")  'Following lines, if enabled, weed out macros and duplicate windows
  48.       'If ColonPos > 2 Then
  49.         'If Right$(temp$, 1) = "1" And Len(temp$) = ColonPos + 1 Then
  50.           'temp$ = Left$(temp$, ColonPos - 1)
  51.         'Else
  52.           'temp$ = ""'Must be macro or duplicate window
  53.         'End If
  54.       'End If
  55.     If temp$ <> "" Then LBox.AddItem temp$
  56.     Next idx
  57.   End If
  58. End Function
  59.  
  60. Function Open_Link () As String
  61. 'This function opens a link with winword as client and returns the channel number
  62. 'Channel number can be used to cause winword to poke data into VB application
  63.   If IsAppLoaded("MSWord") = FALSE Then xxzz = Shell(ProgName, 7)
  64.   mess$ = "[DDEPoke DDEInitiate(" + q + ThisProg + q + "," + q + "DDEForm" + q + "), "
  65.   mess$ = mess$ + q + "Label1" + q + ", Str$(DDEInitiate(" + q + ThisProg + q + ","
  66.   mess$ = mess$ + q + "DDEForm" + q + "))]"
  67.   Execute mess$
  68.   Open_Link = DDEForm.Label1.Caption
  69.   Form1.ChanNum.Caption = Form1.ChanNum.Tag + DDEForm.Label1.Caption 'This statement is included solely for WordDemo and should be disabled for other projects
  70. End Function
  71.  
  72. Sub Execute (mess As String)
  73. 'Executes a WordBASIC command or string of WordBASIC commands
  74.     DDEForm.Label1.LinkTopic = "winword|system"
  75.     DDEForm.Label1.LinkMode = COLD
  76.     DDEForm.Label1.LinkExecute mess
  77.     DDEForm.Label1.LinkMode = NONE
  78. End Sub
  79.  
  80. Function Get_Info (info As String) As String
  81. 'Function returns data obtained from WordBASIC functions
  82.     If chan1 = "" Then chan1 = Open_Link()
  83.     mess$ = "[DDEPoke " + chan1 + "," + q + "Label1" + q + ", " + info + "]"
  84.     Execute mess$
  85.     Get_Info = DDEForm.Label1.Caption
  86. End Function
  87.  
  88. Sub Close_Link ()
  89. 'Closes link with winword
  90.   If IsAppLoaded("MSWord") = FALSE Or chan1 = "" Then Exit Sub
  91.   DDEMessage$ = "[DDETerminateAll]"
  92.   Execute DDEMessage$
  93. End Sub
  94.  
  95. Function Is_Doc_Open (FName As String) As Integer
  96. 'Function returns the position of an open file on winword window list or -1 if file is not open
  97. 'Argument must be full pathname of file to be tested
  98.   If IsAppLoaded("MSWord") = FALSE Then    'Document cannot be open if winword is not running
  99.     Is_Doc_Open = -1
  100.     Exit Function
  101.   End If
  102.   If chan1 = "" Then chan1 = Open_Link()
  103.   NumWins = Val(Get_Info("Str$(CountWindows())"))  'Get number of items on winword open window list
  104.   If NumWins = 0 Then      'No documents are open
  105.     Is_Doc_Open = -1
  106.     Exit Function
  107.   End If
  108.   FName = UCase$(FName) 'Open documents are listed in upper case on winword open window list
  109.   WordDir$ = Get_Info("Files$(" + q + "." + q + ")")   'Get current winword directory
  110.   For idx = 1 To NumWins
  111.     TestFile$ = Get_Info("WindowName$(" + LTrim$(Str$(idx)) + ")")
  112.     ColonPos = InStr(TestFile$, ":")
  113.     If ColonPos = 2 Then
  114.       DLetter$ = Left$(TestFile$, 2)  'File is on a different drive from current winword directory
  115.       TestFile$ = Right$(TestFile$, Len(TestFile$) - 2)
  116.       ColonPos = InStr(TestFile$, ":")
  117.     Else
  118.       DLetter$ = Left$(WordDir$, 2)    'File is on same drive as current winword directory
  119.     End If
  120.     If ColonPos > 0 Then    'Must be a macro or duplicate window
  121.       If Val(Right$(TestFile$, 1)) < 9 And Len(TestFile$) = ColonPos + 1 Then
  122.         TestFile$ = Left$(TestFile$, ColonPos - 1)
  123.       End If
  124.     End If
  125.     If InStr(TestFile$, "\") = 1 Then     'Build full filename
  126.       TestFile$ = DLetter$ + TestFile$   'Add drive if document is not in current directory or subdirectory of current directory
  127.     Else
  128.       TestFile$ = Build_Full_Name(WordDir$, TestFile$)
  129.     End If
  130.     If FName = TestFile$ Then
  131.         Is_Doc_Open = idx
  132.         Exit Function
  133.     End If
  134.   Next idx
  135.   Is_Doc_Open = -1
  136. End Function
  137.  
  138. Function Build_Full_Name (DName As String, FName As String) As String
  139.   If Right$(DName, 1) <> "\" And Left$(FName, 1) <> "\" Then
  140.     Build_Full_Name = DName + "\" + FName
  141.   ElseIf Right$(DName, 1) = "\" And Left$(FName, 1) = "\" Then
  142.     Build_Full_Name = Left$(DName, Len(DName) - 1) + FName
  143.   Else
  144.     Build_Full_Name = DName + FName
  145.   End If
  146. End Function
  147.  
  148. Function Winword_State () As Integer
  149.   If Val(Get_Info("Str$(AppMaximize())")) = 0 Then
  150.     If Val(Get_Info("Str$(AppMinimize())")) = 0 Then
  151.       Winword_State = NORMAL     'The Winword window is in the normal state
  152.     Else
  153.       Winword_State = MINIMIZED  'Winword is minimized
  154.       End If
  155.   Else
  156.     Winword_State = MAXIMIZED    'Winword is maximized
  157.   End If
  158. End Function
  159.  
  160. Sub Create_Document (template As String)
  161. 'Creates a new document based on template; document can read DDE info from VB forms
  162.     If IsAppLoaded("MSWord") = FALSE Then
  163.         xxzz = Shell(ProgName, 3)
  164.     End If
  165.     DDEMessage$ = "[If NOT AppMaximize() Then AppMaximize]"
  166.     DDEMessage$ = DDEMessage$ + "[FileNew.Template=" + q + template + q + "]"
  167.     DDEMessage$ = DDEMessage$ + "[EditSelectAll][UpdateFields][LockFields]"
  168.     DDEMessage$ = DDEMessage$ + "[StartOfDocument]"
  169.     Execute DDEMessage$
  170. End Sub
  171.  
  172. Function Get_Winword_Directory () As String
  173.  
  174.   If Is_File_Name("d:\winword\winword.ini") Then
  175.     Get_Winword_Directory = "d:\winword"
  176.   ElseIf Is_File_Name("c:\winword\winword.ini") Then
  177.     Get_Winword_Directory = "c:\winword"
  178.   Else
  179.     Get_Winword_Directory = InputBox$("Please type full pathname for winword directory")
  180.   End If
  181. End Function
  182.  
  183. Function Is_File_Name (FName As String)
  184. 'This function requires appropriate type and API declarations in the global module
  185. Dim TheStruct As OfStruct ' used to test for open files
  186.   
  187.   xxzz% = OpenFile(FName, TheStruct, OF_EXIST)
  188.   zzxx% = lclose(xxzz%)
  189.   If xxzz% > 0 Then
  190.     Is_File_Name = TRUE
  191.   Else
  192.     Is_File_Name = FALSE
  193.   End If
  194. End Function
  195.  
  196.